home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / ARITH.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-08  |  16.5 KB  |  644 lines
  1. /* ARITH.C
  2.  ************************************************************************
  3.  *                                    *
  4.  *        PC Scheme/Geneva 4.00 Borland C code            *
  5.  *                                    *
  6.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8.  *                                    *
  9.  *----------------------------------------------------------------------*
  10.  *                                    *
  11.  *        Basic Arithmetic (+*-/)                    *
  12.  *                                    *
  13.  *----------------------------------------------------------------------*
  14.  *                                    *
  15.  * Created by: John Jensen        Date: 1985            *
  16.  * Revision history:                            *
  17.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18.  * - 21 Jan 93: Corrected bug in fixflo (killed flosiz) (lb)        *
  19.  *                                    *
  20.  *                    ``In nomine omnipotentii dei''    *
  21.  ************************************************************************/
  22.  
  23. #include    "mysignal.h"
  24. #include    <float.h>
  25. #include    <stdlib.h>
  26. #include    <string.h>
  27. #include    <math.h>
  28. #include    "scheme.h"
  29.  
  30. typedef    enum    { FIX, BIG, FLO }
  31.     NUMBERTAG;
  32.  
  33. typedef    struct {
  34.     NUMBERTAG    tag;
  35.     union {
  36.         double    flo;
  37.         int    fix;
  38.         struct {
  39.             unsigned    size;
  40.             BIGDATA    *big;
  41.         }    B;
  42.     };
  43. }    NUMBER;
  44.  
  45. #define    ABSSMALLER    0x01
  46. #define    ABSGREATER    0x02
  47. #define    SMALLER        0x04
  48. #define    GREATER        0x08
  49. #define    SAMESIGN    0x10
  50.  
  51. /************************************************************************/
  52. /* Support of unary arithmetic operations on values other        */
  53. /* than fixnums.                            */
  54. /************************************************************************/
  55. int    arith1( int op, REGPTR reg )
  56. {
  57.     switch (ptype[CORRPAGE(reg->page)])
  58.     {
  59.     case FLOTYPE:
  60.     {
  61.         double    flo = reg2c(reg)->flonum.data;
  62.         switch( op )
  63.         {
  64.         case MINUS_OP:
  65.             flo = -flo;
  66.             break;
  67.         case ZERO_OP:
  68.             return    flo == 0.0;
  69.         case NEG_OP:
  70.             return    flo < 0.0;
  71.         case POS_OP:
  72.             return    flo > 0.0;
  73.         case ABS_OP:
  74.             if( flo >= 0.0 )
  75.                 return    0;
  76.             else
  77.                 flo = -flo;
  78.             break;
  79.         }
  80.         alloc_flonum( reg, flo );
  81.         return    0;
  82.     }
  83.     case BIGTYPE:
  84.     {
  85.         BIGDATA    far *big = ®2c(reg)->bignum.data;
  86.  
  87.         switch( op )
  88.         {
  89.         case ZERO_OP:
  90.             return    FALSE;
  91.         case POS_OP:
  92.             return    !(big->sign & 1);
  93.         case NEG_OP:
  94.             return    big->sign & 1;
  95.         case ABS_OP:
  96.         case MINUS_OP:
  97.             BIGDATA    *newbig;
  98.  
  99.             if (!(newbig = (BIGDATA *) malloc(big->len+2)))
  100.             {
  101.                 errmsg( HEAPERR );
  102.                 scheme_error();
  103.             }
  104.             copybig( CORRPAGE(reg->page), reg->disp, newbig );
  105.             if( op == ABS_OP )
  106.                 newbig->sign &= 0xfe;
  107.             else    newbig->sign ^= 1;
  108.             alloc_int( reg, newbig );
  109.             free( newbig );
  110.             return    0;
  111.         }
  112.     }
  113.     default:
  114.         not_number( op, reg, &nil_reg );
  115.         return    -1;
  116.     }
  117. }
  118.  
  119. int    getnumber( REGPTR reg, NUMBER &number )
  120. {
  121.     SCHEMEOBJ    o = reg2c(reg);
  122.     unsigned    type = gettype(reg);
  123.  
  124.     switch( type )
  125.     {
  126.     case FIXTYPE:
  127.         number.tag = FIX;
  128.         number.fix = reg->disp;
  129.         break;
  130.     case FLOTYPE:
  131.         number.tag = FLO;
  132.         number.flo = o->flonum.data;
  133.         break;
  134.     case BIGTYPE:
  135.         number.tag = BIG;
  136.         number.B.size = o->bignum.data.len + 4;
  137.         if( !(number.B.big = (BIGDATA *) malloc(number.B.size)) )
  138.         {
  139.             errmsg( HEAPERR );
  140.             scheme_error();
  141.         }
  142.         copybig( CORRPAGE(reg->page), reg->disp, number.B.big );
  143.         break;
  144.     default:
  145.         return    1;
  146.     }
  147.     return    0;
  148. }
  149.  
  150. void    convertnumber( NUMBER &number, NUMBERTAG newtag, REGPTR reg )
  151. {
  152.     if( number.tag == FIX && newtag == FLO )
  153.         number.flo = number.fix;
  154.     else if( number.tag == BIG && newtag == FLO )
  155.     {
  156.         double    d;
  157.  
  158.         if( big2flo( number.B.big, &d ) )
  159.         {
  160.             free( number.B.big );
  161.             dos_error( 1, FLONUM_OVERFLOW_ERROR, reg );
  162.         }
  163.         free( number.B.big );
  164.         number.flo = d;
  165.     } else if( number.tag == FIX && newtag == BIG )
  166.     {
  167.         int    fix = number.fix;
  168.         
  169.         number.B.size = 7;
  170.         if( !(number.B.big = (BIGDATA *) malloc(number.B.size)) )
  171.         {
  172.             errmsg( HEAPERR );
  173.             scheme_error();
  174.         }
  175.         fix2big( fix, number.B.big );
  176.     }
  177.     number.tag = newtag;
  178. }
  179.  
  180. void    dological( BIGDATA *dest, BIGDATA *src, int op )    /* dest > op */
  181. {
  182.     for( int i = 0; i < src->len; i++ )
  183.     switch( op )
  184.     {
  185.     case AND_OP:
  186.         dest->data[i] &= src->data[i];
  187.         break;
  188.     case OR_OP:
  189.         dest->data[i] |= src->data[i];
  190.         break;
  191.     case XOR_OP:
  192.         dest->data[i] ^= src->data[i];
  193.         break;
  194.     }
  195.     if( op == AND_OP )
  196.     for( i = src->len; i < dest->len; i++ )
  197.         dest->data[i] = 0;
  198. }
  199.  
  200. /************************************************************************/
  201. /* Support of binary arithmetic operations on values other        */
  202. /* than fixnums (+, -, *, /, mod)                    */
  203. /************************************************************************/
  204. int    arith2( int op, REGPTR reg1, REGPTR reg2 )
  205. {
  206.     NUMBER    number1, number2;
  207.  
  208.     if( getnumber( reg1, number1 ) || getnumber( reg2, number2 ) )
  209.     {
  210.         not_number( op, reg1, reg2 );
  211.         return    -1;
  212.     }
  213.     if( number1.tag < number2.tag )
  214.         convertnumber( number1, number2.tag, reg1 );
  215.     else if( number1.tag > number2.tag )
  216.         convertnumber( number2, number1.tag, reg2 );
  217.     /* Perform the operation */
  218.     if( number1.tag == FLO )
  219.     {
  220.         switch( op )
  221.         {
  222.         case ADD_OP:
  223.             number1.flo += number2.flo;    break;
  224.         case SUB_OP:
  225.             number1.flo -= number2.flo;    break;
  226.         case MUL_OP:
  227.             number1.flo *= number2.flo;    break;
  228.         case DIV_OP:
  229.             number1.flo /= number2.flo;    break;
  230.         case QUOT_OP:
  231.             set_src_error("QUOTIENT", 2, reg1, reg2 );
  232.             scheme_error();
  233.         case REM_OP:
  234.             number1.flo = fmod( number1.flo, number2.flo );
  235.             break;
  236.         case DIVIDE_OP:
  237.             set_src_error("DIVIDE", 2, reg1, reg2 );
  238.             scheme_error();
  239.         case MOD_OP:
  240.         {
  241.             double    t = fmod( number1.flo, number2.flo );
  242.             if( (number1.flo < 0 ^ number2.flo < 0) && t != 0 )
  243.                 number1.flo = t + number2.flo;
  244.             else    number1.flo = t;
  245.             break;
  246.         }
  247.         case AND_OP:
  248.             set_src_error("LOGAND", 2, reg1, reg2 );
  249.             scheme_error();
  250.         case OR_OP:
  251.             set_src_error("LOGIOR", 2, reg1, reg2 );
  252.             scheme_error();
  253.         case XOR_OP:
  254.             set_src_error("LOGXOR", 2, reg1, reg2 );
  255.             scheme_error();
  256.         case EQ_OP:
  257.             return    number1.flo == number2.flo;
  258.         case NE_OP:
  259.             return    number1.flo != number2.flo;
  260.         case LT_OP:
  261.             return    number1.flo < number2.flo;
  262.         case GT_OP:
  263.             return    number1.flo > number2.flo;
  264.         case LE_OP:
  265.             return    number1.flo <= number2.flo;
  266.         case GE_OP:
  267.             return    number1.flo >= number2.flo;
  268.         }
  269.         alloc_flonum( reg1, number1.flo );
  270.     }
  271.     else {            /* then it's BIGNUMs */
  272.         int    mag = magcomp( number1.B.big, number2.B.big ) & 0x00ff;
  273.         NUMBER    result;
  274.  
  275.         switch( op )
  276.         {
  277.         case SUB_OP:
  278.             number2.B.big->sign ^= 1; /* Negate & fall thru */
  279.             mag ^= SAMESIGN;
  280.         case ADD_OP:
  281.             if( mag & SAMESIGN )
  282.                 if( mag & ABSGREATER )
  283.                 {
  284.                     bigadd( number2.B.big, number1.B.big );
  285.                     alloc_int( reg1, number1.B.big );
  286.                 } else {
  287.                     bigadd( number1.B.big, number2.B.big );
  288.                     alloc_int( reg1, number2.B.big );
  289.                 }
  290.             else {
  291.                 if( mag & ABSGREATER )
  292.                 {
  293.                     bigsub( number2.B.big, number1.B.big );
  294.                     alloc_int( reg1, number1.B.big );
  295.                 } else {
  296.                     bigsub( number1.B.big, number2.B.big );
  297.                     alloc_int( reg1, number2.B.big );
  298.                 }
  299.             }
  300.             break;
  301.         case MUL_OP:    /* if zero, we're done */
  302.             if( (number1.B.big->len == 1 && !number1.B.big->data[0])
  303.                 || (number2.B.big->len == 1 && !number2.B.big->data[0]) )
  304.             {
  305.                 alloc_fixnum( reg1, 0 );
  306.                 break;
  307.             }
  308.             result.B.size = number1.B.size + number2.B.size - 3;
  309.             if( !(result.B.big = (BIGDATA *) malloc(result.B.size)) )
  310.             {
  311.                 free( number1.B.big );
  312.                 free( number2.B.big );
  313.                 errmsg( HEAPERR );
  314.                 scheme_error();
  315.             }
  316.             bigmul( number1.B.big, number2.B.big, result.B.big );
  317.             alloc_int( reg1, result.B.big );
  318.             free( result.B.big );
  319.             break;
  320.         case DIV_OP:
  321.         case QUOT_OP:
  322.         case REM_OP:
  323.         case DIVIDE_OP:
  324.         case MOD_OP:
  325.             if( mag & ABSSMALLER )
  326.             {
  327.                 switch( op )
  328.                 {
  329.                 case DIV_OP:    goto    float_it;
  330.                 case QUOT_OP:
  331.                 case DIVIDE_OP:    alloc_fixnum( reg1, 0 );
  332.                 default:    return    0; /* rem is ok */
  333.                 }
  334.             }
  335.             result.B.size = number1.B.size - number2.B.size + 7;
  336.                 /* at least len, sign & 2 words mantissa for bigdiv */
  337.             if( !(result.B.big = (BIGDATA *) malloc(result.B.size)) )
  338.             {
  339.                 free( number1.B.big );
  340.                 free( number2.B.big );
  341.                 errmsg( HEAPERR );
  342.                 scheme_error();
  343.             }
  344.             if ( number1.B.big->data[ number1.B.big->len - 1 ] & 0x8000 )
  345.             {
  346.                 number1.B.size += 2;
  347.                 number1.B.big = (BIGDATA *) realloc(number1.B.big, number1.B.size);
  348.                 number1.B.big->data[ number1.B.big->len++ ] = 0;
  349.             }
  350.             if( bigdiv( number1.B.big, number2.B.big, result.B.big ) )
  351.             {
  352.                 free( number1.B.big );
  353.                 free( number2.B.big );
  354.                 free( result.B.big );
  355.                 set_numeric_error( 1, ZERO_DIVIDE_ERROR, reg1 );
  356.                 scheme_error();
  357.             }
  358.             if( op == DIV_OP && (number1.B.big->len > 1 || number1.B.big->data[0]) )
  359.                     /* test for fractional result */
  360.             {
  361.                 free( result.B.big );
  362. float_it:
  363.                 free( number1.B.big ); /* drop the remainder */
  364.                 free( number2.B.big ); /* anyway it was trashed */
  365.                 getnumber( reg1, number1 );
  366.                 getnumber( reg2, number2 );
  367.                 convertnumber( number1, FLO, reg1 );
  368.                 convertnumber( number2, FLO, reg2 );
  369.                 alloc_flonum( reg1, number1.flo / number2.flo );
  370.                 return    0;
  371.             }
  372.             switch( op )
  373.             {
  374.             case DIVIDE_OP:
  375.                 if( !(mag & SAMESIGN) && (number1.B.big->len > 1 || number1.B.big->data[0]) )
  376.                 {
  377.                     char    mone[7];
  378.                     fix2big( -1, (BIGDATA *) mone );
  379.                     (magcomp( result.B.big, (BIGDATA *) mone ) & SAMESIGN ?
  380.                         bigadd : bigsub)( (BIGDATA *) mone, result.B.big );
  381.                 }
  382.             case QUOT_OP:
  383.             case DIV_OP:
  384.                 alloc_int( reg1, result.B.big );
  385.                 break;
  386.             case MOD_OP:
  387.                 if( !(mag & SAMESIGN) && (number1.B.big->len > 1 || number1.B.big->data[0]) )
  388.                 {
  389.                     free( number2.B.big );
  390.                     getnumber( reg2, number2 );
  391.                     convertnumber( number2, BIG, reg2 );
  392.                     (magcomp( number1.B.big, number2.B.big ) & SAMESIGN ?
  393.                         bigadd : bigsub)( number1.B.big, number2.B.big );
  394.                     alloc_int( reg1, number2.B.big );
  395.                     break;
  396.                 }
  397.             case REM_OP:
  398.                 alloc_int( reg1, number1.B.big );
  399.                 break;
  400.             }
  401.             free( result.B.big );
  402.             break;
  403.         case AND_OP:
  404.         case OR_OP:
  405.         case XOR_OP:
  406.             if( mag & ABSGREATER )
  407.             {
  408.                 dological( number1.B.big, number2.B.big, op );
  409.                 alloc_int( reg1, number1.B.big );
  410.             } else {
  411.                 dological( number2.B.big, number1.B.big, op );
  412.                 alloc_int( reg1, number2.B.big );
  413.             }
  414.             break;
  415.         case EQ_OP:
  416.         case NE_OP:
  417.         case LT_OP:
  418.         case GT_OP:
  419.         case LE_OP:
  420.         case GE_OP:
  421.             free( number1.B.big );
  422.             free( number2.B.big );
  423.             switch( op )
  424.             {
  425.             case EQ_OP:
  426.                 return    !(mag & (ABSSMALLER | ABSGREATER | SMALLER | GREATER));
  427.             case NE_OP:
  428.                 return    mag & (ABSSMALLER | ABSGREATER | SMALLER | GREATER);
  429.             case LT_OP:
  430.                 return    mag & SMALLER;
  431.             case GT_OP:
  432.                 return     mag & GREATER;
  433.             case LE_OP:
  434.                 return    !(mag & GREATER);
  435.             case GE_OP:
  436.                 return    !(mag & SMALLER);
  437.             }
  438.         }
  439.         free( number1.B.big );
  440.         free( number2.B.big );
  441.     }
  442.     return    0;
  443. }
  444.  
  445. /************************************************************************/
  446. /* float to integer conversion-- truncate (adjust toward zero)        */
  447. /************************************************************************/
  448. int    atruncate(REGPTR reg)
  449. {
  450.     switch (ptype[CORRPAGE(reg->page)]) {
  451.     case FLOTYPE:
  452.         {
  453.             double    d = reg2c(reg)->flonum.data;
  454.             fixflo( reg, d - fmod( d, 1.0 ) );
  455.         }
  456.     case BIGTYPE:    /* bignums and fixnums mutually exclusive */
  457.     case FIXTYPE:    /* already a fixnum, so no action required */
  458.         return    0;
  459.     default:
  460.         not_number(TRUNC_OP, reg, &nil_reg);    /* invalid type */
  461.         return    -1;
  462.     }
  463. }
  464.  
  465. /************************************************************************/
  466. /* float to integer-- floor (adjust toward -infinity)            */
  467. /************************************************************************/
  468. int    afloor(REGPTR reg)
  469. {
  470.     switch (ptype[CORRPAGE(reg->page)]) {
  471.     case FLOTYPE:
  472.         fixflo( reg, floor( reg2c(reg)->flonum.data ) );
  473.     case BIGTYPE:    /* bignums and fixnums mutually exclusive */
  474.     case FIXTYPE:    /* already a fixnum, so no action required */
  475.         return    0;
  476.     default:
  477.         not_number(FLOOR_OP, reg, &nil_reg);    /* invalid type */
  478.         return    -1;
  479.     }
  480. }
  481.  
  482. /************************************************************************/
  483. /* float to integer-- ceiling (adjust toward +infinity)            */
  484. /************************************************************************/
  485. int    aceiling(REGPTR reg)
  486. {
  487.     switch (ptype[CORRPAGE(reg->page)]) {
  488.     case FLOTYPE:
  489.         fixflo( reg, ceil( reg2c(reg)->flonum.data ) );
  490.     case BIGTYPE:    /* bignums and fixnums mutually exclusive */
  491.     case FIXTYPE:    /* already a fixnum, so no action required */
  492.         return    0;
  493.     default:
  494.         not_number(CEIL_OP, reg, &nil_reg);    /* invalid type */
  495.         return    -1;
  496.     }
  497. }
  498.  
  499. /************************************************************************/
  500. /* float to integer-- round (adjust toward nearest integer)        */
  501. /************************************************************************/
  502. int    around(REGPTR reg)
  503. {
  504.     switch (ptype[CORRPAGE(reg->page)]) {
  505.     case FLOTYPE:
  506.         fixflo( reg, reg2c(reg)->flonum.data );    /* re-allocate as an integer */
  507.     case BIGTYPE:        /* bignums and fixnums mutually exclusive */
  508.     case FIXTYPE:        /* already a fixnum, so no action required */
  509.         return    0;
  510.     default:
  511.         not_number(ROUND_OP, reg, &nil_reg);    /* invalid type */
  512.         return    -1;
  513.     }
  514. }
  515.  
  516. /************************************************************************/
  517. /* Convert flonum to integer, which is stored in a register        */
  518. /************************************************************************/
  519. void    fixflo( REGPTR reg, double flo )
  520. {
  521.     if( fabs(flo) < 0.5 )
  522.         alloc_fixnum( reg, 0 );
  523.     else {
  524.         BIGDATA        *bigbuf;
  525.         int    size;
  526.  
  527.         frexp( flo, &size );
  528.  
  529.         if( !(bigbuf = (BIGDATA *) malloc( 5 + size/8 )) ) 
  530.         {
  531.             errmsg(HEAPERR);
  532.             return;
  533.         }
  534.         flotobig( flo, bigbuf );
  535.         alloc_int( reg, bigbuf );
  536.         free( bigbuf );
  537.     }
  538. }
  539.  
  540. /************************************************************************/
  541. /* Convert value to floating point                    */
  542. /************************************************************************/
  543. int    sfloat(REGPTR reg)
  544. {
  545.     NUMBER    number;
  546.  
  547.     if( getnumber( reg, number ) )
  548.     {
  549.         not_number(FLOAT_OP, reg, &nil_reg);
  550.         return    -1;
  551.     }
  552.  
  553.     convertnumber( number, FLO, reg );
  554.     alloc_flonum( reg, number.flo );
  555.     return    0;
  556. }
  557.  
  558. /* What to do when a fixnum result is too large to be fixnum */
  559. void    enlarge(REGPTR reg, long i)
  560. {
  561.     alloc_block(reg, BIGTYPE, labs(i) > 0xffff ? 5 : 3);
  562.     putlong(reg, i);
  563. }
  564.  
  565. /* Arithmetic support error routines    */
  566. /* Arithmetic Operations        */
  567.  
  568. static char    *operation[24] = {"+", "-", "*", "/", "REMAINDER",
  569.     "LOGAND", "LOGIOR", "MINUS", "=?", "<>?",
  570.     "<?", ">?", "<=?", ">=?", "ABS",
  571.     "QUOTIENT", "TRUNCATE", "FLOOR", "CEILING", "ROUND",
  572.     "FLOAT", "ZERO?", "POSITIVE?", "NEGATIVE?"};
  573. /* Note:  TRUE -> binary operation;  FALSE -> unary operation */
  574. static char     binary[24] = {TRUE, TRUE, TRUE, TRUE, TRUE,
  575.     TRUE, TRUE, FALSE, TRUE, TRUE,
  576.     TRUE, TRUE, TRUE, TRUE, FALSE,
  577.     TRUE, FALSE, FALSE, FALSE, FALSE,
  578.     FALSE, FALSE, FALSE, FALSE};
  579.  
  580. void    not_number(int op, REGPTR reg1, REGPTR reg2)
  581. {
  582.     tmp_reg = nil_reg;
  583.     if (binary[op])
  584.         cons(&tmp_reg, reg2, &tmp_reg);
  585.     cons(reg1, reg1, &tmp_reg);
  586.     intern(&tmp_reg, operation[op], strlen(operation[op]));
  587.     cons(reg1, &tmp_reg, reg1);
  588.     set_numeric_error(1, NUMERIC_OPERAND_ERROR, reg1);
  589.     reg1->disp = NTN_DISP;
  590.     reg1->page = ADJPAGE(NTN_PAGE);
  591. }
  592.  
  593. /************************************************************************/
  594. /* Put the next number in the present pseudo-random sequence into REG    */
  595. /* For details on the generator KRANDOM, see the file STIMER.ASM    */
  596. /************************************************************************/
  597. void    srandom(REGPTR reg)
  598. {
  599.     alloc_fixnum( reg, rand() );
  600. }
  601.  
  602. /************************************************************************/
  603. /*     What to do in the event of a floating-point exception         */
  604. /************************************************************************/
  605. #pragma argsused
  606. void    fperror( int sign, int subcode, int *reglist )
  607. {
  608. /* first, bump off all arguments from math stack */
  609.     for( int i = 0; i < 8; i++ )
  610. asm {
  611.         ffree    st(0)
  612.         fdecstp
  613.     }
  614.  
  615.     switch ( subcode ) {
  616.     case FPE_OVERFLOW:        /* Overflow */
  617.     case FPE_INTOVFLOW:
  618.         set_numeric_error( 1, FLONUM_OVERFLOW_ERROR, &nil_reg );
  619.         break;
  620.     case FPE_ZERODIVIDE:        /* Divide by zero */
  621.     case FPE_INTDIV0:
  622.         set_numeric_error( 1, ZERO_DIVIDE_ERROR, &nil_reg );
  623.         break;
  624.     }
  625.     signal( SIGFPE, fperror );    /* restart floating exception handler */
  626.     scheme_error();            /* signal the error to interprt */
  627. }
  628.  
  629. #pragma    warn -rvl
  630. int    matherr( struct exception *e )
  631. {
  632.     switch( e->type )
  633.     {
  634.     case DOMAIN:
  635.     case SING:
  636.     case OVERFLOW:
  637.     case UNDERFLOW:
  638.     case TLOSS:
  639.         set_numeric_error( 1, NUMERIC_OPERAND_ERROR, &nil_reg );
  640.     }
  641.     scheme_error();
  642. }
  643. #pragma    warn +rvl
  644.